home *** CD-ROM | disk | FTP | other *** search
/ SunSoft Catalyst CDWARE 1996 May to August / Catalyst CDWARE 1996 May to August.iso / .products / USoft / cgi-bin / cgi-lib.pl next >
Text File  |  1996-02-15  |  2KB  |  85 lines
  1.  
  2.  
  3. sub ReadParse {
  4.   local (*in) = @_ if @_;
  5.   local ($i, $key, $val);
  6.   # Read in text
  7.   if (&MethGet) {
  8.     $in = $ENV{'QUERY_STRING'};
  9.   } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
  10.     read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  11.   }
  12.   @in = split(/&/,$in);
  13.   foreach $i (0 .. $#in) {
  14.     # Convert plus's to spaces
  15.     $in[$i] =~ s/\+/ /g;
  16.     # Split into key and value.  
  17.     ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
  18.     # Convert %XX from hex numbers to alphanumeric
  19.     $key =~ s/%(..)/pack("c",hex($1))/ge;
  20.     $val =~ s/%(..)/pack("c",hex($1))/ge;
  21.     # Associate key and value
  22.     $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
  23.     $in{$key} .= $val;
  24.   }
  25.   return length($in); 
  26. }
  27. # PrintHeader
  28. # Returns the magic line which tells WWW that we're an HTML document
  29. sub PrintHeader {
  30.   return "Content-type: text/html\n\n";
  31. }
  32. # MethGet
  33. # Return true if this cgi call was using the GET request, false otherwise
  34. sub MethGet {
  35.   return ($ENV{'REQUEST_METHOD'} eq "GET");
  36. }
  37. # MyURL
  38. # Returns a URL to the script
  39. sub MyURL  {
  40.   return  'http://' . $ENV{'SERVER_NAME'} .  $ENV{'SCRIPT_NAME'};
  41. }
  42. # CgiError
  43. # Prints out an error message which which containes appropriate headers,
  44. # markup, etcetera.
  45. # Parameters:
  46. #  If no parameters, gives a generic error message
  47. #  Otherwise, the first parameter will be the title and the rest will 
  48. #  be given as different paragraphs of the body
  49. sub CgiError {
  50.   local (@msg) = @_;
  51.   local ($i,$name);
  52.   if (!@msg) {
  53.     $name = &MyURL;
  54.     @msg = ("Error: script $name encountered fatal error");
  55.   };
  56.   print &PrintHeader;
  57.   print "<html><head><title>$msg[0]</title></head>\n";
  58.   print "<body><h1>$msg[0]</h1>\n";
  59.   foreach $i (1 .. $#msg) {
  60.     print "<p>$msg[$i]</p>\n";
  61.   }
  62.   print "</body></html>\n";
  63. }
  64. # PrintVariables
  65. # Nicely formats variables in an associative array passed as a parameter
  66. # And returns the HTML string.
  67. sub PrintVariables {
  68.   local (%in) = @_;
  69.   local ($old, $out, $output);
  70.   $old = $*;  $* =1;
  71.   $output .=  "<DL COMPACT>";
  72.   foreach $key (sort keys(%in)) {
  73.     foreach (split("\0", $in{$key})) {
  74.       ($out = $_) =~ s/\n/<BR>/g;
  75.       $output .=  "<DT><B>$key</B><DD><I>$out</I><BR>";
  76.     }
  77.   }
  78.   $output .=  "</DL>";
  79.   $* = $old;
  80.   return $output;
  81. }
  82. # PrintVariablesShort
  83. # Nicely formats variables in an associative array passed as a parameter
  84. # 
  85.